home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Eagles Nest BBS 8
/
Eagles_Nest_Mac_Collection_Disc_8.TOAST
/
Developer Tools⁄Additions
/
InsideBa1994
/
InsideBasic-94
/
IB 94
/
Offscreen Animation
/
OffScreen Animation (Z)
< prev
Wrap
Text File
|
1992-07-30
|
8KB
|
269 lines
'----------------------------------------------
' QuickDraw Offscreen Animation Demo (ZBasic)
' by Ross W. Lambert
' Copyright (C) 1991
' All Rights Reserved
'----------------------------------------------
COORDINATE WINDOW
DEF MOUSE=-1:WIDTH -2
' ---------------- Resources
'Hndl& = FN GETRESOURCE(CVI("Ross"),0) ' unREM for Z5
'LONG IF Hndl& = 0
'ResRef = FN OPENRESFILE("Animation.res")
'IF ResRef = 0 THEN END
'END IF
RESOURCES "Animation.Res" ' comment out for Z5
' ---------------- Data Structures
DIM T,L,B,R 'temp working rectangle
SaucerID = 2000 'starting resource ID of saucer shape set
SaucerPICTs = 6 'number images in saucer set
RockID = 3000 'starting res ID of rock PICT bank
RockPICTs = 12 'images in rock bank (change to suit)
DIM ShRect(9,3) 'screen coordinates for each shape
DIM XInc(9), YInc(9) 'movement increments in pixels, x & y
DIM IntShape(9) 'Curr shape num (for internal animation)
DIM MoveLimits(9,3) 'rects describing movement limits
' ---------------- Functions
DIM OffT,OffL,OffB,OffR
LONG FN MakePort&(RPtr&)
CALL GETPORT(OldPort&)
BLOCKMOVE RPtr&,VARPTR(OffT),8
MemAvail& = FN FREEMEM
RowBytes = ((OffR+15)/16) * 2
MapSz& = RowBytes * ((OffB-OffT)+1) + 14' 14 bytes for BMap record
LONG IF MapSz& < MemAvail& + 25000'24K extra for window memory!
OffPort& = FN NEWPTR(192)
CALL OPENPORT(OffPort&) 'copies port info from active port
BLOCKMOVE VARPTR(OffT),OffPort&+16,8'make port rect right size
VisRgn& = PEEK LONG (OffPort&+24)'set vis rgn & clip rgn to size
CALL RECTRGN(VisRgn&,OffT)
ClipRgn& = PEEK LONG (OffPort&+28)
CALL RECTRGN(ClipRgn&,OffT)
Map& = FN NEWPTR(MapSz&) 'get a pointer for bitmap and screenbits
POKE LONG Map&,Map&+14 'screenbits starts here
POKE WORD Map&+4,RowBytes 'bytes per row
BLOCKMOVE VARPTR(OffT),Map&+6,8'rectangle
CALL SETPORTBITS(#Map&) 'make our screenbits data bits for port
PEN ,,,,0 'color background of bitmap black
CALL PAINTRECT(OffT) '<<< change to suit your app
END IF
CALL SETPORT(OldPort&)
END FN = OffPort&
'---------------------------------------
LONG FN KillPort(KPort&)
LONG IF KPort& <> 0
CALL CLOSEPORT(KPort&) 'nukes visrgn and cliprgn on its own...
OSErr = FN DISPOSPTR(PEEK LONG(KPort&+2)-14)' nukes bitmap
OSErr = FN DISPOSPTR(KPort&) ' and the port's memory
END IF
END FN
'---------------------------------------
LONG FN GetPictRect(ResID,RectPtr&)
Hndl& = FN GETPICTURE(ResID)
LONG IF Hndl&
BLOCKMOVE PEEK LONG (Hndl&)+2,RectPtr&,8'copy to dest rect
END IF
END FN
'---------------------------------------
DIM PictT,PictL,PictB,PictR
DIM PortT,PortL,PortB,PortR
LONG FN SetUpOffScrn&(ResID,NumShapes)
FN GetPictRect(ResID,VARPTR(PictT))
ShHt = PictB-PictT 'compute height and width (GLOBAL!!!)
ShWdth = PictR-PictL
PortB = ShHt 'PortL and PortT = 0
PortR = ShWdth * NumShapes
END FN = FN MakePort&(VARPTR(PortT))'return with grafport pointer
'--------------------------
DIM ShT,ShL,ShB,ShR
DIM PT,PL,PB,PR
LONG FN DrawOffScreen (OffPort&,ResID,NumShapes,ShapeWdth)
CALL GETPORT(OldPort&)
CALL SETPORT(OffPort&)
ShT = 0 : ShL = 0
FOR Shape = 0 TO NumShapes - 1
Hndl& = FN GETPICTURE(ResID+Shape)
LONG IF Hndl&
PICTURE (ShL,ShT),Hndl&
END IF
ShL = ShL + ShapeWdth
NEXT
CALL SETPORT(OldPort&)
END FN
'----------------------------------------
DIM LimT,LimL,LimB,LimR
LONG FN MoveShape(Num,NumShapes)
BLOCKMOVE VARPTR(MoveLimits(Num,0)),VARPTR(LimT),8'
IF ShRect(Num,1) <= LimL OR ShRect(Num,3) => LimR THEN XInc(Num)=XInc(Num)* -1
IF ShRect(Num,0) <= LimT OR ShRect(Num,2) => LimB THEN YInc(Num)= YInc(Num)* -1
CALL OFFSETRECT(ShRect(Num,0),XInc(Num),YInc(Num))'move to new pos
' are we going to collide with another shape?
FOR ColCk = 0 TO GTotalShapes-1
Collision = FN SECTRECT(ShRect(Num,0),ShRect(ColCk,0),T)
LONG IF Collision AND ColCk <> Num
XInc(Num) = XInc(Num)*-1
YInc(Num)=YInc(Num)*-1
CALL OFFSETRECT(ShRect(Num,0),XInc(Num),YInc(Num))
END IF
NEXT
IntShape(Num) = IntShape(Num) + 1
IF IntShape(Num) > NumShapes-1 THEN IntShape(Num) = 0
END FN
'----------------------------------------
DIM ShpT,ShpL,ShpB,ShpR
LONG FN DrawShape(ShapeNum,NumShapes,SWdth,SHt,OnScrn&,OffScrn&)
FN MoveShape(ShapeNum,NumShapes)' update position
ShpT = 0
ShpL = IntShape(ShapeNum) * SWdth'start of shape data offscrn
ShpB = SHt
ShpR = ShpL + SWdth
CALL COPYBITS(#OffScrn&+2,#OnScrn&+2,ShpT,ShRect(ShapeNum,0),8,0)
END FN
'-------------------------- Main Program ----------------------------
SaucerOffScrn& = FN SetUpOffScrn&(SaucerID,SaucerPICTs)
LONG IF SaucerOffScrn& 'only continue if valid!
SaucerWdth = ShWdth 'returned globally from FN SetUpOffScrn
SaucerHt = ShHt
RockOffScrn& = FN SetUpOffScrn&(RockID,RockPICTs)
LONG IF RockOffScrn& 'are we still okay?
RockWdth = ShWdth 'returned globally from FN SetUpOffScrn
RockHt = ShHt
' -------------------- Define Saucer Data ---------------------
' *** Shape #1 *** 'the first shape is the zeroth in array
'
' establish initial position
'
CALL SETRECT(ShRect(0,0),10,20,10+SaucerWdth,20+SaucerHt)
XInc(0) = 3 : YInc(0) = 3 'initial direction and speed
' *** Shape #2 ***
CALL SETRECT(ShRect(1,0),200,20,200+SaucerWdth,20+SaucerHt)
XInc(1) = -3 : YInc(1) = -3 'going up & left a little faster
' *** Shape #3 ***
CALL SETRECT(ShRect(2,0),75,190,75+SaucerWdth,190+SaucerHt)
XInc(2) = 3 : YInc(2) = 2
' *** Shape #4 ***
CALL SETRECT(ShRect(3,0),95,230,95+SaucerWdth,230+SaucerHt)
XInc(3) = 3 : YInc(3) = 3
' *** Shape #5 ***
CALL SETRECT(ShRect(4,0),230,210,230+SaucerWdth,210+SaucerHt)
XInc(4) = 2 : YInc(4) = 3
' ------------------ Define Rock Data -----------------------
' *** Shape #6 ***
CALL SETRECT(ShRect(5,0),110,110,110+RockWdth,110+RockHt)
XInc(5) = 4 : YInc(5) = 4
' *** Shape #7 ***
CALL SETRECT(ShRect(6,0),160,160,160+RockWdth,160 + RockHt)
XInc(6) = -4: YInc(6) = 4 'rock moves fast down & left to start
' *** Shape #8 ***
CALL SETRECT(ShRect(7,0),240,60,240+RockWdth,60+RockHt)
XInc(7) = -2 : YInc(7) = -2
' *** Shape #9 ***
CALL SETRECT(ShRect(8,0),140,60,140+RockWdth,60+RockHt)
XInc(8) = -4 : YInc(8) = -4
' *** Shape #10 ***
CALL SETRECT(ShRect(9,0),40,160,40+RockWdth,160+RockHt)
XInc(9) = 2 : YInc(9) = -2
' we're going to animate five saucers and five rocks
TotSaucers = 5
TotRocks = 5
GTotalShapes = 10
T = 30 : L = 10 : B = 330 : R = 500
WINDOW 1,"",(L,T)-(R,B),3
PEN ,,,,0 ' solid black penpat
CALL OFFSETRECT(T,-L,-T)
CALL PAINTRECT(T)
'
' establish movement limits (same as window rect for simplicity)
'
FOR Shape = 0 TO GTotalShapes-1
BLOCKMOVE VARPTR(T),VARPTR(MoveLimits(Shape,0)),8
NEXT
CALL GETPORT(CurrPort&)
FN DrawOffScreen(SaucerOffScrn&,SaucerID,SaucerPICTs,SaucerWdth)
FN DrawOffScreen(RockOffScrn&,RockID,RockPICTs,RockWdth)
' This is the main animation loop
CALL HIDECURSOR
DO
T& = FN TICKCOUNT + 1 'establish timing for all Macs
FOR Saucer = 0 TO TotSaucers-1
FN DrawShape(Saucer,SaucerPICTs,SaucerWdth,SaucerHt,CurrPort&,SaucerOffScrn&)
NEXT
FOR Rock = TotSaucers TO TotSaucers+TotRocks-1
FN DrawShape(Rock,RockPICTs,RockWdth,RockHt,CurrPort&,RockOffScrn&)
NEXT
DO:UNTIL FN TICKCOUNT > T&
UNTIL FN BUTTON 'in this case, loop until a mouse click
CALL SHOWCURSOR
WINDOW CLOSE 1 'clean up our mess and leave
FN KillPort(RockOffScrn&)
END IF
FN KillPort(SaucerOffScrn&)
END IF
'CALL CLOSERESFILE(ResRef) ' uncomment for Z5
END